; ORIGINAL: 3dt2.1/examples/where.scm
; $Id: where.scm,v 1.3 1996/10/21 15:59:48 aed Exp $
;- where.scm ------------------------------------------------------
; Track and display the cursor location.
; (where #t) turns on cursor tracking, and (where #f) turns off cursor tracking.
;------------------------------------------------------------------
(require 'old-rb "old-rb.scm")

(define where
  (lambda (onoff)
    (let* ((prev-event #f)
      (tag (lambda (pe)
         (let ((pos (pick:position pe))
                    (v (event:view pe)))
            (view:set-rb-mode #t v)
            (view:draw-text pos (format #f "(~a, ~a, ~a)"
                  (position:x pos) (position:y pos) (position:z pos)) v)
            (view:set-rb-mode #f v)
           )
         ))

      (update (lambda (pe)
                 (if prev-event
                   (tag prev-event)
                   #f)
                 (if pe
                   (tag pe)
                   #f)
                 (set! prev-event pe)
               )
         ))

      (if onoff
        ;; TRUE: Define mouse hooks for tracking position
        (begin
          (set! mouse-down-hook
            (lambda (pe)
                          (update pe)
                          (set! rb-update-hook update)
                          (rb:scheme #t)
            )
          )
          (set! mouse-up-hook
            (lambda (pe)
                          (update #f)
                          (rb:scheme #f)
            )
          )
        )
        ;; FALSE: Turn off tracking capability
        (begin
                  (update #f)
          (set! mouse-down-hook '())
          (set! mouse-up-hook '())
          (set! rb-update-hook '())
        )
      )
      ;; Return the new setting
      onoff
    )
  )
)


